﻿Public Class ParserDriver
    Private m_productionManager As ProductionManager

    Private m_scanner As IScanner
    Private m_stateStack As Stack(Of StackEntry)

    Private m_parserState As ParserState

    Protected ReadOnly Property StackTopStateIndex() As Integer
        Get
            Debug.Assert(m_stateStack.Count > 0)
            Return m_stateStack.Peek().StateIndex
        End Get
    End Property

    Protected ReadOnly Property StackTopState() As LR1TransitionTableRow
        Get
            Return m_productionManager.TransitionTable(StackTopStateIndex)
        End Get
    End Property

    Protected ReadOnly Property CurrentScannerContext() As ScannerContext
        Get
            Return New ScannerContext(StackTopState)
        End Get
    End Property

    Protected Sub PushState(ByVal stateIndex As Integer, ByVal syntaxObject As Object)
        m_stateStack.Push(New StackEntry With {.StateIndex = stateIndex, .SyntaxObject = syntaxObject})
    End Sub

    Protected Function PopState() As StackEntry
        Return m_stateStack.Pop
    End Function

    Public Sub New(ByVal mgr As ProductionManager, ByVal scanner As IScanner)
        m_productionManager = mgr
        m_scanner = scanner

        m_stateStack = New Stack(Of StackEntry)
    End Sub

    Public Sub Start()
        m_parserState = ParserState.Parsing

        PushState(0, Nothing)

        ParserLoop()
    End Sub

    Private Function ParserLoop() As Boolean

        'The loop that drives the entire parsing
        Do While m_parserState = ParserState.Parsing
            ParserAction()
        Loop

        Return True


    End Function

    Private Sub ParserAction()

        'peek one token
        Dim peekToken = m_scanner.Peek()

        Dim nextAction = StackTopState.Actions(peekToken.Terminal)

        'get the shift 
        Dim shift = TryCast(nextAction, LR1Shift) 'm_tokenMapping.GetShift(peekToken)

        If shift IsNot Nothing Then
            DoShift(shift)
            Exit Sub
        End If

        'try reduce
        Dim reduce = TryCast(nextAction, Reduce)
        If reduce IsNot Nothing Then
            DoReduce(reduce)
            Exit Sub
        End If

        'Error handling
        RecoverError()
    End Sub

    Private Sub RecoverError()
        Dim err = m_productionManager.Error

        Dim nextAction As ILR1Action = Nothing

        Do While m_stateStack.Count > 0
            nextAction = StackTopState.Actions(err)

            If nextAction IsNot Nothing AndAlso TypeOf nextAction Is LR1Shift Then
                Exit Do
            Else
                PopState()
            End If
        Loop

        If nextAction Is Nothing Then
            'could not recover error
            m_parserState = ParserState.Aborted
            Exit Sub
        End If

        DoShift(TryCast(nextAction, LR1Shift))

        'skip input tokens when the lookahead token has a non-error action
        Dim lookAhead As IToken = Nothing
        Dim recoveredAction As ILR1Action = Nothing
        Do Until m_scanner.Peek.IsEndOfFile
            lookAhead = m_scanner.Peek()
            recoveredAction = StackTopState.Actions(lookAhead.Terminal)

            If recoveredAction IsNot Nothing Then
                Exit Do
            Else
                'skip this token
                m_scanner.Read()
            End If
        Loop

        If recoveredAction Is Nothing Then
            'not recovered, finished
            m_parserState = ParserState.Stopped
            Exit Sub
        End If
    End Sub

    Private Sub DoReduce(ByVal reduce As Reduce)
        Dim production = reduce.ReduceProduction
        Dim reduceRule = production.SemanticRule

        'pop all the states from stack in sequence
        Dim listOfResults(production.Sequence.Count - 1) As Object

        For i = 1 To production.Sequence.Count
            Dim entry = PopState()
            listOfResults(production.Sequence.Count - i) = entry.SyntaxObject
        Next

        Dim context As New ParserContext(production, listOfResults)

        'run the reduce rule
        Dim reducedObject As Object = Nothing
        If reduceRule IsNot Nothing Then
            reducedObject = reduceRule(context)
        End If

        'find the current top-stack state
        Dim nextAction = StackTopState.Actions(production.NonTerminal)

        Debug.Assert(TypeOf nextAction Is LR1Goto)
        Dim gotoAction = TryCast(nextAction, LR1Goto)

        'create a new entry
        PushState(gotoAction.TargetStateIndex, reducedObject)

        'finished reduce
    End Sub

    Private Sub DoShift(ByVal shift As LR1Shift)
        Dim shiftToken = m_scanner.Read
        Dim nextState = shift.TargetStateIndex

        If nextState = LR1TransitionTable.AcceptStateIndex Then
            Accept()

            Exit Sub
        End If

        'push state into stack
        PushState(nextState, shiftToken)
    End Sub

    Private Sub Accept()
        'finish parsing, raise finish event
        m_parserState = ParserState.Stopped
    End Sub

    Protected Structure StackEntry
        Public StateIndex As Integer
        Public SyntaxObject As Object
    End Structure
End Class
